Business Shareware/Business Shareware.iso/start/wordproc/me_cd25/makeback.mut

Text File | 1992-05-11 | 4.9 KB | 200 lines

  ;; $Source: c:/lib/mutt/RCS/makeback.mut $
  ;; $Revision: 1.5 $
  ;; $Date: 1992/05/12 00:19:48 $
  ;; Bob Stocker Public Domain

(const BACKUP-CHAR '~')            ;; Last character in "type" field
                    ;; of the "backup" (i.e. previous
                    ;; version) of a file.

            ;; NOTE: Changing these commands to fit other
            ;; operating systems may not be enough.  For example,
            ;; the "mv" command on Unix systems may require
            ;; that both files be specified with pathnames.  A
            ;; pathname for the second file is not allowed by
            ;; the MS-DOS "rename" command.  Check code in which
            ;; these constants are used before running these
            ;; programs on a different operating system.

(const DELETE-COMMAND "del")        ;; OS command to delete a file
(const RENAME-COMMAND "rename")        ;; OS command to rename a file

            ;; Routines in this (defun) are highly operating
            ;; system dependent.

(defun
  external-file-name (string fn)
            ;; Translates internal filename to exteranl
            ;; filename.

            ;; MS-DOS version -- translates '/' to '\'.

{                    ;; BEGIN external-file-name
  (int i l)
  (string fname)
  (fname (fn))
  (l (length-of fname))
  (for
    (i 0)
    (< i l)
    (+= i 1)
    (if
      (== (extract-element fname i) '/')
    {                    ;; BEGIN / -> \
      (insert-object fname i '\')
      (remove-elements fname i 1)
    }                    ;; END   / -> \
    )
  )
  (fname)
}                    ;; END   external-file-name
)

;;
;; ================================================================
;;

(defun
  make-backup-name (string fname)
            ;; Creates a new name for the previous version
            ;; of the file being edited.
{                    ;; BEGIN make-backup-name
  (int i imin l)
  (string bname c)
  (bname (fname))
  (l (length-of bname))
  (imin (- l 4))
  (if (< imin 0) (imin 0))
  (for
    (i (- l 1))
    (>= i imin)
    (-= i 1)
  {                    ;; BEGIN scan for "."
    (if
      (== (extract-element bname i) ".")
    {                    ;; BEGIN found "."
      (if
        (== (- l i) 4)
    (remove-elements bname (- l 1) 1)
      )
      (concat bname BACKUP-CHAR)
      (done)
    }                    ;; END   found "."
    )
  }                    ;; END   scan for .
  )
  (concat bname "." BACKUP-CHAR)
}                    ;; END   make-backup-name
;;
;; ================================================================
;;
  zap-path (string fname)
            ;; Deletes any path prefix on a filename.
{                    ;; BEGIN zap-path
  (int i l)
  (string c only-name)
  (only-name fname)
  (l (length-of fname))
  (for
    (i (- l 1))
    (>= i 0)
    (-= i 1)
  {                    ;; BEGIN scan for /:\
    (c (extract-element fname i))
    (if
      (or
        (== c '/')
        (== c '\')
        (== c ':')
      )
    {                    ;; BEGIN zap d:\pathname
      (only-name
        (extract-elements
      fname
      (+ i 1)
      (- l i 1)
    )
      )
      (break)
    }                    ;; END   zap d:\pathname
    )
    }                    ;; END   scan for /:\
  )
  (only-name)
}                    ;; END   zap-path
;;
;; ================================================================
;;
  save-buffer-with-backup
            ;; Renames the previous version of the file before
            ;; saving the buffer.
{                    ;; BEGIN save-buffer-with-backup
  (string fname)
  (string bname)
  (int i l)
  (fname (file-name (current-buffer)))
  (l (length-of fname))
  (if
    (file-exists fname)
  {                    ;; BEGIN file exists
    (bname (make-backup-name fname))
    (if
      (file-exists bname)
    {                    ;; BEGIN del
      (msg "Deleting " bname)
      (OS-filter
        (concat
      DELETE-COMMAND " "
      (external-file-name bname)
    )
      )
    }                    ;; END   del
    )
    (msg "Renaming original to " bname)
    (OS-filter
      (concat
        RENAME-COMMAND " "
    (external-file-name fname)
    " "
    (zap-path bname)
      )
    )
  }                    ;; END   file exists
  )
  (save-buffer)
}                    ;; END   save-buffer-with-backup
)

            ;; Programs in this (defun) may be useful for
            ;; debugging.

;;  TEST  (defun
;;  TEST  test-backup-name
;;  TEST  {
;;  TEST    (string fn)                ;; BEGIN test-backup-name
;;  TEST    (ask-user)
;;  TEST    (fn (ask "File: "))
;;  TEST    (msg "File: " fn "  Backup: " (make-backup-name fn))
;;  TEST  }                    ;; END   test-backup-name
;;  TEST  ;;
;;  TEST  ;; ================================================================
;;  TEST  ;;
;;  TEST   test-external-file-name
;;  TEST  {
;;  TEST    (string fn)                ;; BEGIN test-external-file-name
;;  TEST    (ask-user)
;;  TEST    (fn (ask "File: "))
;;  TEST    (msg "File: " fn "  MS-DOS: " (external-file-name fn))
;;  TEST  }                    ;; END   test-external-file-name
;;  TEST  ;;
;;  TEST  ;; ================================================================
;;  TEST  ;;
;;  TEST    test-zap-path
;;  TEST  {
;;  TEST    (string fn)                ;; BEGIN test-zap-path
;;  TEST    (ask-user)
;;  TEST    (fn (ask "File: "))
;;  TEST    (msg "File: " fn "  Zapped file: " (zap-path fn))
;;  TEST  }                    ;; END   test-zap-path
;;  TEST  )